home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue59 / RichEdit / DCRichEdit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-05-25  |  4.3 KB  |  169 lines
  1. unit DCRichEdit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ComCtrls;
  8.  
  9. type
  10.   TDCRichEdit = class(TRichEdit)
  11.   private
  12.     FRTF, FSavedRTF: String;
  13.     //Fake RTF property reader
  14.     procedure ReadData(Reader: TReader);
  15.     //Fake RTF property writer
  16.     procedure WriteData(Writer: TWriter);
  17.   protected
  18.     //Routine to define fake RTF property
  19.     procedure DefineProperties(Filer: TFiler); override;
  20.     procedure CreateWnd; override;
  21.     procedure DestroyWnd; override;
  22.   published
  23.     //Stop the Lines property from storing itself
  24.     property Lines stored False;
  25.   end;
  26.  
  27. //Turn Lines property into string with formatting
  28. function RichEditLinesToString(RichEdit: TCustomRichEdit): String;
  29. //Take RTF string and give it to Lines property
  30. procedure StringToRichEditLines(
  31.   const AString: String; RichEdit: TCustomRichEdit);
  32. //Copy RTF from one rich edit control to another
  33. procedure RichEditLinesToRichEditLines(Src, Dest: TCustomRichEdit);
  34.  
  35. implementation
  36.  
  37. type
  38.   TRichEditAccess = class(TCustomRichEdit);
  39.  
  40. //The parameters for these two routines are declared as TCustomRichEdit
  41. //This is to allow as many rich edit descendants to work with this
  42. //code as possible. However, in TCustomRichEdit, the inherited
  43. //TCustomMemo.Lines public property is more accessible than the new
  44. //protected TCustomRichEdit.Lines property. The access class above
  45. //newer protected property to be accessed.
  46. function RichEditLinesToString(RichEdit: TCustomRichEdit): String;
  47. var
  48.   Stream: TMemoryStream;
  49. begin
  50.   if not Assigned(RichEdit) then
  51.   begin
  52.     Result := '';
  53.     Exit
  54.   end;
  55.   //Create a memory stream
  56.   Stream := TMemoryStream.Create;
  57.   try
  58.     //Copy Lines into stream, inc. formatting
  59.     TRichEditAccess(RichEdit).Lines.SaveToStream(Stream);
  60.     //Set stream pointer to BOF
  61.     Stream.Position := 0;
  62.     //Read from stream into a string
  63.     SetString(Result, PChar(Stream.Memory), Stream.Size)
  64.   finally
  65.     Stream.Free
  66.   end
  67. end;
  68.  
  69. procedure StringToRichEditLines(
  70.   const AString: String; RichEdit: TCustomRichEdit);
  71. var
  72.   Stream: TStream;
  73. begin
  74.   if not Assigned(RichEdit) then
  75.     Exit;
  76.   if Length(AString) = 0 then
  77.     RichEdit.Lines.Clear
  78.   else
  79.   begin
  80.     //Create a memory stream
  81.     Stream := TMemoryStream.Create;
  82.     try
  83.       //Copy RTF data into stream
  84.       Stream.Write(AString[1], Length(AString));
  85.       //Set stream pointer to BOF
  86.       Stream.Position := 0;
  87.       //Load RTF into Lines property, inc. formatting
  88.       TRichEditAccess(RichEdit).Lines.LoadFromStream(Stream)
  89.     finally
  90.       Stream.Free
  91.     end
  92.   end
  93. end;
  94.  
  95. procedure RichEditLinesToRichEditLines(Src, Dest: TCustomRichEdit);
  96. var
  97.   SrcStream, DestStream: TStream;
  98. begin
  99.   SrcStream := TMemoryStream.Create;
  100.   try
  101.     DestStream := TMemoryStream.Create;
  102.     try
  103.       Src.Lines.SaveToStream(SrcStream);
  104.       SrcStream.Position := 0;
  105.       DestStream.CopyFrom(SrcStream, 0);
  106.       DestStream.Position := 0;
  107.       Dest.Lines.LoadFromStream(DestStream)
  108.     finally
  109.       DestStream.Free
  110.     end
  111.   finally
  112.     SrcStream.Free
  113.   end
  114. end;
  115.  
  116. procedure TDCRichEdit.ReadData(Reader: TReader);
  117. begin
  118.   //Read RTF from form file and give it to Lines, with formatting (if required)
  119.   if PlainText then
  120.     Lines.Text := Reader.ReadString
  121.   else
  122.     StringToRichEditLines(Reader.ReadString, Self);
  123. end;
  124.  
  125. procedure TDCRichEdit.WriteData(Writer: TWriter);
  126. begin
  127.   //Get string containing text and formatting (if required)
  128.   if PlainText then
  129.     Writer.WriteString(Lines.Text)
  130.   else
  131.     Writer.WriteString(RichEditLinesToString(Self))
  132. end;
  133.  
  134. procedure TDCRichEdit.DefineProperties(Filer: TFiler);
  135.  
  136.   function DoWrite: Boolean;
  137.   begin
  138.     FRTF := RichEditLinesToString(Self);
  139.     if Assigned(Filer.Ancestor) then
  140.     begin
  141.       Result := True;
  142.       if Filer.Ancestor is TDCRichEdit then
  143.         Result := FRTF <> TDCRichEdit(Filer.Ancestor).FRTF
  144.     end
  145.     else
  146.       Result := Lines.Count > 0;
  147.   end;
  148.  
  149. begin
  150.   inherited;
  151.   Filer.DefineProperty('RTF', ReadData, WriteData, DoWrite)
  152. end;
  153.  
  154. procedure TDCRichEdit.CreateWnd;
  155. begin
  156.   inherited;
  157.   if not PlainText then
  158.     StringToRichEditLines(FSavedRTF, Self);
  159. end;
  160.  
  161. procedure TDCRichEdit.DestroyWnd;
  162. begin
  163.   if not PlainText then
  164.     FSavedRTF := RichEditLinesToString(Self);
  165.   inherited
  166. end;
  167.  
  168. end.
  169.